home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DS-CD ROM 2 1993 August
/
DS CD-ROM 2.Ausgabe (August 1993).iso
/
programm
/
ds0045
/
spritsrc.exe
/
SPRITEED.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-08-30
|
16KB
|
528 lines
program sprite_editor; {Version 1.2 vom 29.01.1991}
uses drv_link,crt,graph,mouselib,butlib;
const max_x_gr = 32;
max_y_gr = 32;
var sprite_exists : boolean;
sprite_saved : boolean;
programm_ende : boolean;
ident : array [0..3] of byte;
daten : array [0..max_x_gr-1,0..max_y_gr-1] of byte;
spr_x_gr : byte;
spr_y_gr : byte;
sprite_color : word;
sprite_bk : word;
myfile : file;
dum_char : char;
procedure def_buttons;
var t : integer;
begin
enter_default_graphmode;
sprite_color:=getmaxcolor;
sprite_bk:=0;
deftextbutton(1,1,1,21,'Col 01',false,' ',0);
deftextbutton(1,2,1,23,'Col 02',false,' ',0);
deftextbutton(1,3,9,21,'Col 03',false,' ',0);
deftextbutton(1,4,9,23,'Col 04',false,' ',0);
deftextbutton(1,5,17,21,'Col 05',false,' ',0);
deftextbutton(1,6,17,23,'Col 06',false,' ',0);
deftextbutton(1,7,25,21,'Col 07',false,' ',0);
deftextbutton(1,8,25,23,'Col 08',false,' ',0);
deftextbutton(1,9,33,21,'Col 09',false,' ',0);
deftextbutton(1,10,33,23,'Col 10',false,' ',0);
deftextbutton(1,11,41,21,'Col 11',false,' ',0);
deftextbutton(1,12,41,23,'Col 12',false,' ',0);
deftextbutton(1,13,49,21,'Col 13',false,' ',0);
deftextbutton(1,14,49,23,'Col 14',false,' ',0);
deftextbutton(1,15,57,21,'Col 15',false,' ',0);
deftextbutton(1,16,57,23,'Col 16',false,' ',0);
deftextbutton(1,17,70,21,' Clear ',true,' ',0);
deftextbutton(1,18,70,23,' Exit ',true,' ',0);
for t:=1 to 16 do begin
button_colors[1,t,0]:=t-1;
button_colors[1,t,1]:=t-1;
if t<11 then button_colors[1,t,2]:=15 else button_colors[1,t,2]:=0;
end;
button_colors[1,1,1]:=15;
button_colors[1,17,2]:=12;
button_colors[1,18,2]:=10;
closegraph;
end;
procedure empty_key_buf;
var dummy : char;
begin
while keypressed do dummy:=readkey;
end;
function big_menu : word;
var wahl : char;
ok : integer;
dummy : integer;
begin
clrscr;
writeln('SPRITLIB V1.2 (C) 1991 Uwe Kuhring - Sprites für Turbo Pascal.');
writeln('Dies ist der Sprite-Editor (SPRITEED.EXE).');
writeln('');
writeln('');
writeln('Folgende Funktionen stehen Ihnen zur Auswahl:');
writeln('');
writeln(' <1> = Neues Sprite definieren.');
writeln(' <2> = Aktuelles Sprite editieren.');
writeln(' <3> = Aktuelles Sprite speichern.');
writeln(' <4> = Altes Sprite laden.');
writeln(' <5> = Aktuelles Sprite konvertieren.');
writeln(' <0> = Sprite-Editor verlassen.');
empty_key_buf;
repeat
repeat until keypressed;
wahl:=readkey;
val (wahl,dummy,ok);
until (ok=0) and (dummy<6) and (dummy>-1);
big_menu:=dummy;
end;
function sicherheit : boolean;
var wahl : char;
begin
sicherheit:=true;
if sprite_exists then if not sprite_saved then begin
clrscr;
writeln ('Dieses Kommando führt zum Verlust des aktuellen Sprites!');
writeln ('Soll ich das Kommando <a>usführen oder <z>urücknehmen?');
empty_key_buf;
repeat
repeat until keypressed;
wahl:=readkey;
until (upcase(wahl)='Z') or (upcase(wahl)='A');
if upcase(wahl)='Z' then sicherheit:=false;
end;
end;
procedure neue_definitionen;
var xs : string;
ys : string;
ok : integer;
t : integer;
u : integer;
begin
clrscr;
writeln('Bitte definieren Sie nun die Größe des neuen Sprites.');
writeln('Der zulässige Bereich in X ist: 8..',max_x_gr);
writeln('Der zulässige Bereich in Y ist: 8..',max_y_gr);
empty_key_buf;
repeat
writeln('');
write('Größe des Sprites in X: ');
readln(xs);
val(xs,spr_x_gr,ok);
if (ok<>0) or (spr_x_gr<8) or (spr_x_gr>max_x_gr) then ok:=0 else ok:=1;
if ok=0 then writeln ('Die Eingabe war unkorrekt, bitte wiederholen!');
until ok=1;
empty_key_buf;
repeat
writeln('');
write('Größe des Sprites in Y: ');
readln(ys);
val(ys,spr_y_gr,ok);
if (ok<>0) or (spr_y_gr<8) or (spr_y_gr>max_y_gr) then ok:=0 else ok:=1;
if ok=0 then writeln ('Die Eingabe war unkorrekt, bitte wiederholen!');
until ok=1;
for t:=0 to max_x_gr-1 do for u:=0 to max_y_gr-1 do daten[t,u]:=0;
sprite_exists:=true;
sprite_saved:=false;
end;
procedure warnton;
begin
sound(50);
delay(100);
sound(30);
delay(200);
nosound;
end;
procedure edit_sprite;
var gx,gy : word;
rax,ray : word;
t,u : integer;
mb,but : integer;
c_merk : integer;
x,y,b : integer;
lxpos : word;
procedure fill_square(x,y,c : integer);
begin
if c<0 then c:=-c else if c=1 then c:=sprite_color else c:=sprite_bk;
c_merk:=getcolor;
setcolor(c);
setfillstyle(1,c);
mouseoff;
rectangle(x*rax+1,y*ray+1,(x+1)*rax-1,(y+1)*ray-1);
floodfill(x*rax+2,y*ray+2,c);
putpixel(lxpos+x,100+y,c);
daten[x,y]:=c;
mouseon;
setcolor(c_merk);
end;
begin
enter_default_graphmode;
cleardevice;
lxpos:=getmaxx-max_x_gr;
gx:=trunc((getmaxx+1)*0.75) ; gy:=trunc((getmaxy+1)*0.75);
rax:=trunc(gx/spr_x_gr) ; ray:=trunc(gy/spr_y_gr);
for t:=0 to spr_x_gr do line(t*rax,0,t*rax,spr_y_gr*ray);
for t:=0 to spr_y_gr do line(0,t*ray,spr_x_gr*rax,t*ray);
defbuttonplane(1) ; mouseon;
for t:=0 to spr_x_gr-1 do for u:=0 to spr_y_gr-1 do begin
if daten[t,u]>0 then fill_square(t,u,-daten[t,u]);
end;
repeat
pressedbutton(but,mb,dum_char);
if mb>0 then begin
if but=18 then if mb=1 then begin
revertbutton(18);
repeat mousestat(x,y,b) until b=0;
revertbutton(18);
mouseoff;
closegraph;
exit;
end;
if but=17 then if mb=1 then begin
revertbutton(17);
for t:=0 to spr_x_gr-1 do for u:=0 to spr_y_gr-1 do
if daten[t,u]<>sprite_bk then fill_square(t,u,2);
repeat mousestat(x,y,b) until b=0;
revertbutton(17);
end;
if (but>0) and (but<17) and (mb in [1,2]) then begin
revertbutton(but);
if mb=1 then sprite_color:=but-1 else sprite_bk:=but-1;
repeat mousestat(x,y,b) until b=0;
revertbutton(but);
end;
if but=0 then if mb in [1,2] then begin
mousestat(x,y,b);
x:=x div rax ; y:=y div ray;
if (x<spr_x_gr) and (y<spr_y_gr) then begin
fill_square(x,y,mb);
sprite_saved:=false;
end
else begin
if mb=1 then begin
revertbutton(sprite_color+1);
delay(10);
revertbutton(sprite_color+1);
end
else begin
revertbutton(sprite_bk+1);
delay(10);
revertbutton(sprite_bk+1);
end;
end;
end;
end;
until false;
end;
procedure sprite_speichern;
var name : string;
begin
clrscr;
writeln('Bitte geben Sie jetzt den Pfad- und Dateinamen des Sprites ein:');
write('Speichern unter: ');
empty_key_buf;
readln(name);
writeln('');
if name='' then begin
writeln('Speichervorgang wurde abgebrochen.');
delay(1000);
exit;
end;
{$I-}
assign(myfile,name);
ident[0]:=ord('T') ; ident[1]:=ord('S');
ident[2]:=spr_x_gr ; ident[3]:=spr_y_gr;
rewrite(myfile,4);
blockwrite(myfile,ident[0],1);
blockwrite(myfile,daten[0,0],256);
close(myfile);
{$I+}
if ioresult=0 then begin
writeln ('Speicherung war erfolgreich.');
sprite_saved:=true;
end
else begin
writeln('Speicherung des Sprites ist nicht gelungen!');
warnton;
end;
delay(2000);
end;
procedure sprite_laden;
var name : string;
begin
clrscr;
writeln('Bitte geben Sie jetzt den Pfad- und Dateinamen des Sprites ein:');
write('Lade Sprite: ');
empty_key_buf;
readln(name);
writeln('');
if name='' then begin
writeln('Ladevorgang wurde abgebrochen.');
delay(1000);
exit;
end;
{$I-}
assign(myfile,name);
reset(myfile,4);
blockread(myfile,ident[0],1);
blockread(myfile,daten[0,0],256);
close(myfile);
{$I+}
if ioresult=0 then writeln ('Datei wurde korrekt geladen.')
else begin
writeln('Das Sprite konnte nicht geladen werden!');
warnton;
delay(2000);
sprite_exists:=false ; sprite_saved:=false;
exit;
end;
if (chr(ident[0])='T') and (chr(ident[1])='S') then begin
writeln('Die Datei ist ein Sprite von TP_SPRIT.');
spr_x_gr:=ident[2] ; spr_y_gr:=ident[3];
sprite_exists:=true ; sprite_saved:=true;
end
else begin
writeln('Die Datei ist KEIN Sprite von TP-SPRIT!');
warnton;
sprite_exists:=false ; sprite_saved:=false;
end;
delay(3000);
end;
procedure verschieben(n : integer ; frage : boolean);
var schub : string;
pixs : integer;
ok : word;
t,u,v : integer;
begin
if frage then begin
clrscr;
write ('Um wieviele Pixel verschieben ? ');
readln (schub);
writeln('');
val(schub,pixs,ok);
if (ok<>0) or (pixs<1) or ((pixs>max_x_gr) and (pixs>max_y_gr)) then begin
writeln ('Die Angabe war nicht korrekt - keine Verschiebung vorgenommen.');
warnton;
delay(2500);
exit;
end;
end
else begin
pixs:=spr_x_gr;
if spr_y_gr>pixs then pixs:=spr_y_gr;
end;
ok:=1 ; t:=0;
if n=3 then repeat
for u:=0 to spr_y_gr-1 do if daten[0,u]<>sprite_bk then ok:=0;
if ok=1 then begin
for u:=1 to spr_x_gr-1 do for v:=0 to spr_y_gr-1 do
daten[u-1,v]:=daten[u,v];
for u:=0 to spr_y_gr-1 do daten[spr_x_gr-1,u]:=sprite_bk;
end;
if ok=1 then inc(t);
until (ok=0) or (t=pixs);
if n=2 then repeat
for u:=0 to spr_y_gr-1 do if daten[spr_x_gr-1,u]<>sprite_bk then ok:=0;
if ok=1 then begin
for u:=spr_x_gr-2 downto 0 do for v:=0 to spr_y_gr-1 do
daten[u+1,v]:=daten[u,v];
for u:=0 to spr_y_gr-1 do daten[0,u]:=sprite_bk;
end;
if ok=1 then inc(t);
until (ok=0) or (t=pixs);
if n=1 then repeat
for u:=0 to spr_x_gr-1 do if daten[u,spr_y_gr-1]<>sprite_bk then ok:=0;
if ok=1 then begin
for u:=spr_y_gr-2 downto 0 do for v:=0 to spr_x_gr-1 do
daten[v,u+1]:=daten[v,u];
for u:=0 to spr_x_gr-1 do daten[u,0]:=sprite_bk;
end;
if ok=1 then inc(t);
until (ok=0) or (t=pixs);
if n=0 then repeat
for u:=0 to spr_x_gr-1 do if daten[u,0]<>sprite_bk then ok:=0;
if ok=1 then begin
for u:=1 to spr_y_gr-1 do for v:=0 to spr_x_gr-1 do
daten[v,u-1]:=daten[v,u];
for u:=0 to spr_x_gr-1 do daten[u,spr_y_gr-1]:=sprite_bk;
end;
if ok=1 then inc(t);
until (ok=0) or (t=pixs);
if frage then begin
writeln ('Das Sprite konnte um ',t,' Pixel verschoben werden.');
delay(2500);
end;
end;
procedure konvert_sprite;
var wahl : char;
ok : integer;
dummy : integer;
k_ende : boolean;
t,u : integer;
xs,ys : string;
x,y : word;
begin
k_ende:=false;
repeat
clrscr;
writeln('Folgende Kovertierungen stehen Ihnen zur Auswahl:');
writeln('');
writeln(' <1> = Sprite auf Minimalgröße bringen.');
writeln(' <2> = Sprite auf Maximalgröße bringen.');
writeln(' <3> = Sprite auf vorgegebene Größe bringen.');
writeln(' <4> = Sprite nach oben verschieben.');
writeln(' <5> = Sprite nach unten verschieben.');
writeln(' <6> = Sprite nach rechts verschieben.');
writeln(' <7> = Sprite nach links verschieben.');
writeln(' <0> = Sprite-Konverter verlassen.');
empty_key_buf;
repeat
repeat until keypressed;
wahl:=readkey;
val (wahl,dummy,ok);
until (ok=0) and (dummy<8) and (dummy>-1);
case dummy of
0 : k_ende:=true;
1 : begin
clrscr;
writeln ('Sprite wird auf Minimalgröße gebracht.');
verschieben(0,false) ; verschieben(3,false);
u:=spr_x_gr-1 ; ok:=1;
while (u>7) and (ok=1) do begin
for t:=0 to spr_y_gr-1 do if daten[u,t]<>sprite_bk then
ok:=0;
if ok=1 then begin
for t:=0 to spr_y_gr-1 do daten[u,t]:=0;
dec(spr_x_gr);
end;
dec(u);
end;
u:=spr_y_gr-1 ; ok:=1;
while (u>7) and (ok=1) do begin
for t:=0 to spr_x_gr-1 do if daten[t,u]<>sprite_bk then
ok:=0;
if ok=1 then begin
for t:=0 to spr_x_gr-1 do daten[t,u]:=0;
dec(spr_y_gr);
end;
dec(u);
end;
delay(2000);
end;
2 : begin
clrscr;
writeln ('Sprite wird auf Maximalgröße gebracht.');
for t:=0 to max_x_gr-1 do begin
if t<spr_x_gr then
for u:=spr_y_gr to max_y_gr-1 do daten[t,u]:=sprite_bk
else
for u:=0 to max_y_gr-1 do daten[t,u]:=sprite_bk;
end;
spr_x_gr:=max_x_gr ; spr_y_gr:=max_y_gr;
delay(2000);
end;
3 : begin
clrscr;
writeln('Bitte definieren Sie nun die neue Größe des Sprites.');
writeln('Der zulässige Bereich in X ist: 8..',max_x_gr);
writeln('Der zulässige Bereich in Y ist: 8..',max_y_gr);
writeln('Verkleinerung ist nur möglich, soweit es das Sprite erlaubt.');
empty_key_buf;
writeln('');
write('Größe des Sprites in X: ');
readln(xs);
val(xs,x,ok);
if (ok<>0) or (x<8) or (x>max_x_gr) then ok:=0 else ok:=1;
if ok=0 then begin
writeln ('Die Eingabe war unkorrekt, Funktion abgebrochen.');
warnton;
delay(2000);
end
else begin
write('Größe des Sprites in Y: ');
readln(ys);
val(ys,y,ok);
if (ok<>0) or (y<8) or (y>max_y_gr) then ok:=0 else ok:=1;
if ok=0 then begin
writeln ('Die Eingabe war unkorrekt, Funktion abgebrochen.');
warnton;
delay(2000);
end;
end;
if ok=1 then begin
writeln ('Sprite wird angepaßt.');
verschieben(0,false) ; verschieben(3,false);
u:=spr_x_gr-1 ; ok:=1;
while (u>x-1) and (ok=1) do begin
for t:=0 to spr_y_gr-1 do if daten[u,t]<>sprite_bk then
ok:=0;
if ok=1 then begin
for t:=0 to spr_y_gr-1 do daten[u,t]:=0;
dec(spr_x_gr);
end;
dec(u);
end;
u:=spr_y_gr-1 ; ok:=1;
while (u>y-1) and (ok=1) do begin
for t:=0 to spr_x_gr-1 do if daten[t,u]<>sprite_bk then
ok:=0;
if ok=1 then begin
for t:=0 to spr_x_gr-1 do daten[t,u]:=0;
dec(spr_y_gr);
end;
dec(u);
end;
for t:=0 to x-1 do begin
if t<spr_x_gr then
for u:=spr_y_gr to y-1 do daten[t,u]:=sprite_bk
else
for u:=0 to y-1 do daten[t,u]:=sprite_bk;
end;
if x>spr_x_gr then spr_x_gr:=x;
if y>spr_y_gr then spr_y_gr:=y;
delay(2000);
end;
end;
4 : verschieben(0,true);
5 : verschieben(1,true);
6 : verschieben(2,true);
7 : verschieben(3,true);
end;
until k_ende;
end;
begin
programm_ende:=false;
sprite_exists:=false;
sprite_saved:=false;
def_buttons;
dum_char:=chr(255);
repeat
case big_menu of
0 : if sicherheit then programm_ende:=true;
1 : if sicherheit then neue_definitionen;
2 : if sprite_exists then edit_sprite else warnton;
3 : if sprite_exists then sprite_speichern else warnton;
4 : if sicherheit then sprite_laden;
5 : if sprite_exists then konvert_sprite else warnton;
end;
until programm_ende;
clrscr;
end.